perm filename NOIR.F4[MSS,LCS]1 blob sn#075919 filedate 1974-03-19 generic text, type T, neo UTF8
00100		SUBROUTINE NOIR(RMINI)
00200	C  BLACKS IN NOTES
00300		COMMON/DL/IXRX,Q,AA
00400		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
00500		COMMON/PLTR/IPLT,RHT,DIS
00600		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
00700		EQUIVALENCE (JF,JQ(4))
00800		DATA IXGP/1200/,BL/7.4/,BH/6.5/,CX/1.0/,FL/0.0/
00866	C  ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
01000		JXGP=WDS(250)
01110		B=CENTR*RHT
01120		C=CX
01130		IF(B)C=-C
01140		KC=B+C
01155		D=RJB*DIS
01200		B=BH*RMINI*RHT
01300		A=BL*RMINI*DIS
01320		BX=.5
01340		IF(D)BX=-BX
01500		C=A+D+BX
01550	C ROUND-OFF MAY GIVE SMALL ERROR WHEN X COORD.=NEAR 0.
01600		A=A*A
01700		K=B+FL
01800		B=B*B
01900	C  USES EQUATION FOR ELLIPSE
02000		N=1
02100	5	L=C
02200		JY=KC
02300		IF(IXRX.EQ.0)GO TO 4
02400		JY=IXGP+L
02500		L=JXGP-KC
02600	4	CALL PLOT(L,JY,3)
02700	6	DO 1 J=-K,K
02800		Y=J*J
02900		JY=J+KC
03000		X=SQRT(A-(A*Y)/B)
03100		L=C-X
03200		M=C+X
03300	C  THE TWO SIDES OF THE LINE
03400		JZ=JY
03500		IF(N)CALL EXCH(L,M)
03900		IF(IXRX.EQ.0)GO TO 3
04000		I=L
04100		L=JXGP-JY
04200		JY=IXGP+I
04300		JZ=M
04400		M=L
04500		JZ=IXGP+JZ
04600	3	CALL PLOT(L,JY,2)
04700		CALL PLOT(M,JZ,2)
04800	1	N=-N
05000		END
06000	
07000		SUBROUTINE NUMB
07200		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07300		DIMENSION ISU(320),R(8,100)
07500		COMMON RJB,JA,CENTR,JB,RJQ(20),JQ(20)
07600		COMMON/POSI/STFF(8),JJB,POS/XRN/RN(4000)
07700		COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
07800		EQUIVALENCE (RJD,RJQ(2)),(JF,JQ(4)),(RJE,RJQ(3)),
07900		1(ISU(1),ST(3600)),(R,RN(3001))
08000		CALL DPYSET(3,ISU,320)
08100		CALL DPYBRT(6)
08200		JF=1
08300		RA=100
08400		RB=R(3,1)
08500		POS=STFF(IFIX(RB)+4)
08600		RJD=RB+16.
08700		JA=5
08800		RJE=1
08900		DO 1 K=1,50
09000		IF(R(1,K).NE.1.OR.R(2,K).EQ.RA)GO TO 1
09100		IF(R(3,K).NE.RB)GO TO 2
09200		RA=R(2,K)
09300	C  FOR DOUBLE STOPS
09400		JB=RHORZ(RA+2)
09600		CALL NOTWRT
09700	C  GOES TO DRAW A NUMBER OVER A NOTE
09800		JF=JF+1
09900		IF(JF.EQ.10)JF=0
10000	1	IF(R(1,K).EQ.100)GO TO 2
10100	2	CALL DPYOUT(3)
10200		CALL SETPOG(1)
10400		END